home *** CD-ROM | disk | FTP | other *** search
- ' -- XYPACKET.BAS --
- '
- ' This program is donated to the Public
- ' Domain by MarshallSoft Computing, Inc.
- ' It is provided as an example of the use
- ' of the Personal Communications Library.
- '
- ' LONG (4-byte) variables are used for checksums
- ' because Visual Basic doesn't support unsigned
- ' integers. The string Buffer$ is used because
- '
- '
-
- DefInt A-Z
-
- '$INCLUDE: 'DEFINES.BI'
- '$INCLUDE: 'TIMING.BI'
- '$INCLUDE: 'PCL4B.BI'
- '$INCLUDE: 'TERM_IO.BI'
- '$INCLUDE: 'CRC.BI'
- '$INCLUDE: 'XYPACKET.BI'
-
- DECLARE FUNCTION HIGH (BYVAL Word)
-
- Const xyBufferSize = 1024
- Const MAXTRY = 3, LIMIT = 20
- Const SOH = 1, STX = 2, EOT = 4
- Const ACK = 6, NAK = 21, CAN = 24
- CONST FALSE = 0, TRUE = NOT FALSE
-
-
- Function RxPacket (ByVal Port, ByVal PacketNbr, Buffer$, PacketSize, ByVal NCGbyte, EOTflag)
- 'Port : Port # [0..3)
- 'PacketNbr : Packet # [0,1,2,...)
- 'PacketSize: Packet size [128,1024) {returned}
- 'NCGbyte : NAK, "C", or "G"
- 'EOTflag : EOT was received {returned}
- '
- PacketNbr = PacketNbr And 255
- For Attempt = 1 To MAXTRY
- 'wait FOR SOH / STX
- Code = SioGetc(Port, LONG_WAIT * ONE_SECOND)
- If Code = -1 Then
- Print "Timed out waiting FOR sender"
- RxPacket = False
- Exit Function
- End If
- Select Case Code
- Case SOH
- '128 byte buffer incoming
- PacketType = SOH
- PacketSize = 128
- Case STX
- '1024 byte buffer incoming
- PacketType = STX
- PacketSize = 1024
- Case EOT
- 'all packets have been sent
- Code = SioPutc(Port, ACK)
- EOTflag = True
- RxPacket = True
- Exit Function
- Case CAN
- 'sender has canceled !
- Print "Canceled by remote"
- RxPacket = False
- Case Else
- 'error !
- Print "Expecting SOH/STX/EOT/CAN not "; Code
- RxPacket = False
- End Select
- 'receive packet #
- Code = SioGetc(Port, ONE_SECOND)
- If Code = -1 Then
- Print "Timed out waiting for packet #"
- Exit Function
- End If
- RxPacketNbr = Code And 255
- 'receive 1's complement
- Code = SioGetc(Port, ONE_SECOND)
- If Code = -1 Then
- Print "Timed out waiting for complement of packet #"
- RxPacket = False
- Exit Function
- End If
- RxPacketNbrC = Code And 255
- 'receive data
- CheckSum& = 0
- Buffer$ = ""
- Buffer$ = String$(PacketSize, 0)
- For I = 1 To PacketSize
- Code = SioGetc(Port, ONE_SECOND)
- If Code = -1 Then
- Print "Timed out waiting for data for packet #"
- RxPacket = False
- Exit Function
- End If
- Mid$(Buffer$, I, 1) = Chr$(Code)
- 'compute CRC or checksum
- If NCGbyte <> NAK Then
- CheckSum& = UpdateCRC&(CheckSum&, Code)
- Else
- CheckSum& = (CheckSum& + Code) And 255
- End If
- Next I
- 'receive CRC/checksum
- If NCGbyte <> NAK Then
- 'receive 2 byte CRC
- Code = SioGetc(Port, ONE_SECOND)
- If Code = -1 Then
- Print "Timed out waiting for 1st CRC byte"
- Exit Function
- End If
- RxCheckSum1& = Code And 255
- Code = SioGetc(Port, ONE_SECOND)
- If Code = -1 Then
- Print "Timed out waiting for 2nd CRC byte"
- RxPacket = False
- Exit Function
- End If
- RxCheckSum2& = Code And 255
- RxCheckSum& = (256 * RxCheckSum1&) Or RxCheckSum2&
- Else
- 'receive one byte checksum
- Code = SioGetc(Port, ONE_SECOND)
- If Code = -1 Then
- Print "Timed out waiting for checksum"
- RxPacket = False
- Exit Function
- End If
- RxCheckSum& = Code And 255
- End If
- 'don't send ACK IF "G"
- If NCGbyte = Asc("G") Then
- RxPacket = True
- Exit Function
- End If
- 'packet # and checksum OK ?
- If (RxCheckSum& = CheckSum&) And (RxPacketNbr = PacketNbr) Then
- 'ACK the packet
- Code = SioPutc(Port, ACK)
- RxPacket = True
- Exit Function
- End If
- 'bad packet
- If RxCheckSum& = CheckSum& Then
- Print "Bad Packet. Received "; RxPacketNbr; ", expected "; PacketNbr
- Else
- Print "Bad Checksum. Received "; RxCheckSum&; ", expected "; CheckSum&
- End If
- Code = SioPutc(Port, NAK)
- Next Attempt
- 'can't receive packet
- Print "RX packet timeout"
- RxPacket = False
- End Function
-
- Function RxStartup (ByVal Port, ByVal NCGbyte)
- 'clear Rx buffer
- Code = SioRxFlush(Port)
- 'Send NAKs or "C"s
- For I = 1 To LIMIT
- AnyKey$ = INKEY$
- If AnyKey$ <> "" Then
- Print "Canceled by user"
- RxStartup = False
- Exit Function
- End If
- 'stop attempting CRC after 1st 4 tries
- If (NCGbyte <> NAK) And (I = 5) Then NCGbyte = NAK
- 'tell sender that I am ready to receive
- Code = SioPutc(Port, NCGbyte)
- Byte = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
- If Byte <> -1 Then
- 'no error -- must be incoming byte -- push byte back onto queue !
- Code = SioUnGetc(Port, Byte)
- RxStartup = True
- Exit Function
- End If
- Next I
- 'no response
- Print "No response from sender"
- RxStartup = False
- End Function
-
- Function TxEOT (ByVal Port)
- For I = 0 To 10
- Code = SioPutc(Port, EOT)
- 'await response
- Code = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
- If Code = ACK Then
- TxEOT = True
- Exit Function
- End If
- Next I
- TxEOT = False
- End Function
-
- Function TxPacket (ByVal Port, ByVal PacketNbr, Buffer$, ByVal PacketSize, ByVal NCGbyte)
- 'Port : Port # [0..3)
- 'PacketNbr : Packet # [0,1,2,...)
- 'PacketSize: Packet size [128,1024)
- 'NCGbyte : NAK, "C", or "G"
- '
- 'better be 128 or 1024 packet length
-
- '''PRINT "TxP: Port=";Port;"Packet#=";PacketNbr;"LEN=";LEN(Buffer$);"PacketSize=";PacketSize;",NCGbyte=";CHR$(NCGbyte)
-
- If PacketSize = 1024 Then
- PacketType = STX
- Else
- PacketType = SOH
- End If
- PacketNbr = PacketNbr And 255
- 'make up to MAXTRY attempts to send this packet
- For Attempt = 1 To MAXTRY
- 'send SOH/STX
- Code = SioPutc(Port, PacketType)
- 'send packet #
- Code = SioPutc(Port, PacketNbr)
- 'send 1's complement of packet
- Code = SioPutc(Port, 255 - PacketNbr)
- 'send data
- CheckSum& = 0
- For I = 1 To PacketSize
- Byte = Asc(Mid$(Buffer$, I, 1))
- Code = SioPutc(Port, Byte)
- 'update checksum
- If NCGbyte <> NAK Then
- CheckSum& = UpdateCRC&(CheckSum&, Byte)
- Else
- CheckSum& = CheckSum& + Byte
- End If
- Next I
- 'send checksum
- If NCGbyte <> NAK Then
- 'send 2 byte CRC
- CS = (CheckSum& \ 256)
- Code = SioPutc(Port, CS)
- CS = (CheckSum& And 255)
- Code = SioPutc(Port, CS)
- Else
- 'send one byte checksum
- CS = CheckSum&
- Code = SioPutc(Port, CS)
- End If
- 'don't wait for ACK if "G"
- If NCGbyte = Asc("G") Then
- If PacketNbr = 0 Then Code = SioDelay(SHORT_WAIT * ONE_SECOND / 2)
- TxPacket = True
- Exit Function
- End If
- 'wait for receivers ACK
- Code = SioGetc(Port, LONG_WAIT * ONE_SECOND)
- If Code = CAN Then
- Print "Canceled by remote"
- TxPacket = False
- Exit Function
- End If
- If Code = ACK Then
- TxPacket = True
- Exit Function
- End If
- If Code <> NAK Then
- Print "Out of sync. Expect ACK or NAK, not"; Code
- TxPacket = False
- Exit Function
- End If
- Next Attempt
- 'can't send packet !
- Print 'Packet timeout for port ';Port
- TxPacket = False
- End Function
-
- Function TxStartup (ByVal Port, NCGbyte)
- 'clear Rx buffer
- Code = SioRxFlush(Port)
- 'wait for receivers start up NAK or "C"
- For I = 1 To LIMIT
- AnyKey$ = INKEY$
- If AnyKey$ <> "" Then
- Print "Aborted by user"
- TxStartup = False
- Exit Function
- End If
- Code = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
- If Code <> -1 Then
- 'received a byte
- If Code = NAK Then
- NCGbyte = NAK
- TxStartup = True
- Exit Function
- End If
- If Code = Asc("C") Then
- NCGbyte = Asc("C")
- TxStartup = True
- Exit Function
- End If
- If Code = Asc("G") Then
- NCGbyte = Asc("G")
- TxStartup = True
- Exit Function
- End If
- End If
- Next I
- 'no response
- Print "no response from receiver"
- TxStartup = False
- End Function
-
-